home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / mask12.arc / MASKDEMO.BAS < prev    next >
Encoding:
BASIC Source File  |  1988-01-07  |  7.8 KB  |  148 lines
  1. '                              MASKINPUT
  2. '                       (C) 1987 By Kevin L. Curtis
  3. '                              12/30/87
  4. '
  5. '     Routine Name:  MASKINPUT
  6. '          Version:  1.0
  7. '       Written by:  Kevin L. Curtis
  8. '         Language:  QuickBASIC 3.0
  9. '
  10. '          Purpose:  A highly versatile user input routine that uses
  11. '                    a mask$ value passed much like the picture function
  12. '                    in some popular Data Base products.
  13. '
  14. '******************** NOTE ** NOTE ** NOTE ** NOTE ** NOTE ** NOTE ***********
  15. '
  16. '     MASKDEMO.EXE:  Demo file for maskinput does check for the display
  17. '                    mode.  If you are having trouble reading the screen
  18. '                    then start with the command "MASKDEMO BW".  This will
  19. '                    ensure you of Black and White/Mono mode instead of
  20. '                    color.
  21. '*****************************************************************************
  22. '
  23. '          Example:  mask$ = "(   )   -    "   for phone number or
  24. '                    mask$ = space$(40)        for blank field.
  25. '
  26. 'Parameters passed:  row%,col%,FieldTextAttr%,mask$,DefaultVal$,ReturnVal$,
  27. '                     ftype% = 0
  28. '            Where:  row% = Row for field input.
  29. '                    col% = Column for field input.
  30. '                    FieldTextAttr% = Use ADVBAS CALL CALCATTR(foreground%,_
  31. '                            background%,FieldTextAttr%) to get FieldTextAttr% value or
  32. '                            (BACKGROUND * 16) + FOREGROUND = Attr%.
  33. '                    mask$ = What ever you want your field to look like.
  34. '                            "   -  -   " or "  /  /  "
  35. '                    DefaultVal$ = the default value for the field.  This
  36. '                                  text will be left justified so use spaces
  37. '                                  if you want it in a special position.
  38. '                    ReturnVal$ = the return value form user input
  39. '                    ftype% = 0 for alphanumeric, -1 for numeric values only
  40. '                    Exitkey% = the ASCII number of the key that exited the
  41. '                               routine.  Use this to verify special functions.
  42. '
  43. 'NEXT VERSION IMPROVEMENTS: Minimum and maximum value validation with
  44. '                           automatic maximum validation from length of
  45. '                           mask$ if no maximum value is passed.  Will
  46. '                           also allow for commas and decimal places so
  47. '                           you can use the data returned with the PRINT
  48. '                           USING statement.
  49. '
  50. '   NOTES:  When I use this routine I define a global array for special
  51. '           keys.  This will let you to check for HELP of Allowable ENTER
  52. '           or EXIT keys like: F1 - F10; TAB; CURSOR UP/DOWN PGUP/DN etc.
  53. '           This allows you to exit the routine and take care of a request-
  54. '           ed function like HELP and then return the ReturnVal$ as the
  55. '           DefaultVal$ putting the user back where they left via the
  56. '           ReturnCurrentPOS% value.
  57. '
  58. 'This is a Shareware product.  If you find it useful a donation of your
  59. 'choice 1$-10$ would be appreciated. I will be upgrading the product in
  60. 'the near future.  How soon depends on your response.
  61. '
  62. 'If you upload this file to your favorite BBS, please leave these comments
  63. 'and instructions complete and intact.  As for yourself, go ahead and delete
  64. 'all of the comments so you don't have to page down 20 times every time you
  65. 'want to look at the source code.
  66. '
  67. 'SEND DONATIONS AND/OR COMMENTS TO:
  68. '
  69. '                      SoftwareValue FLAP  ->(For Little As Possible)
  70. '                      7710 Swiss
  71. '                      Rowlett, TX 75088
  72. '                      (214)475-7586
  73. '
  74. '*****************************************************************************
  75.  
  76. ' These variables are a MUST for using MASKINPUT
  77. '************** DECLARE SOME COMMON VARIABLES **************
  78. COMMON SLColor%,StatRow%,StatCol%,LastKey%,NormAttr%,SkColor%,FieldChar%
  79. COMMON ReturnCurrentPOS%,FGColor%,BGColor%
  80. '*************** DIM GLOBAL ARRAYS ****************
  81. DIM SHARED maskpos%(40,1), COLPOS%(80), FieldPos%(80)
  82. '*************** INCLUDE FILES NEEDED ********************
  83. REM $INCLUDE : 'Statlin.Inc'    ' Contains routine for CAPS INS SCRL NUM
  84. REM $INCLUDE : 'Getkey.Inc'     ' Loop for getting a key and updating statlin
  85. REM $INCLUDE : 'Status.Inc'     ' Routine for displaying Status Line Messages
  86. REM $INCLUDE : 'Mask.Inc'       ' Mask input routine
  87. '*********************************************************
  88. ' END OF MUST variables
  89.  
  90. '************************ MASKDEMO.EXE PROGRAM ********************
  91.  
  92. DEF SEG=&H40 : videotype% = (PEEK (7) AND PEEK(8)) AND &H03 'Check Video Type
  93. DEF SEG         'Restore SEG to Basic Segment
  94. IF COMMAND$ = "BW" THEN videotype% = 3
  95. IF LEFT$(COMMAND$,1) = "C" THEN videotype% = 2
  96. IF videotype% = 3  THEN    'IF it's MONO Monitor or B&W
  97.           call calcattr(0,7,SkColor%):CALL CALCATTR(0,7,SLColor%)
  98.           call calcattr(15,0,NormTextAttr%): call calcattr(7,0,NormAttr%)
  99.           call calcattr(0,7,FieldTextAttr%) : FGColor% = 7 : BGColor% = 0
  100. ELSE
  101.           call calcattr(1,7,SkColor%):CALL CALCATTR(1,7,SLColor%)
  102.           call calcattr(15,1,NormTextAttr%): call calcattr(7,1,NormAttr%)
  103.           call calcattr(1,7,FieldTextAttr%) : FGColor% = 7 : BGColor% = 1
  104. END IF
  105.  
  106. row% = 5: col% = 10:FieldChar% = 32:StatRow%= 25: StatCol%=60: LastKey% = 1
  107.  
  108. mask$ = "(   )   -    "    ' Our mask template for user input
  109. 'mask$ = space$(40)        ' Example of a blank field
  110. DefaultVal$ = "214"               ' This gives us a default area code for phone number
  111. ReturnVal$ = ""                  ' NULL new value
  112. COLOR 15,BGColor%,BGColor%:cls           ' Set colors and clear screen
  113. CALL XQPRINT("F1 FOR MORE INFORMATION - ESC TO QUIT DEMO",1,1,15,0)
  114. call xqprint(space$(80),25,1,SkColor%,0)    'Make sure the status line is clear
  115.  
  116. '********************** SOME TEXT FOR THE DEMO *********************
  117. call xqprint("Parameters Passed :  mask$ = "+chr$(34)+"(  )   -    "+chr$(34),2,26,NormTextAttr%,0)
  118. call xqprint("default_value$ = "+chr$(34)+"214"+chr$(34),3,47,NormTextAttr%,0)
  119. call xqprint("Notice the 214 default and the cursor positioned at the",5,25,NormTextAttr%,0)
  120. call xqprint("first available space on the field ready for your input",6,25,NormTextAttr%,0)
  121. call xqprint("This is the status line for INS CAPS NUM & SCRL",23,33,NormTextAttr%,0)
  122. call xqprint(chr$(25)+"    "+chr$(25)+"    "+chr$(25)+"    "+chr$(25),24,62,NormTextAttr%,0)
  123. call xqprint("PHONE",5,4,NormTextAttr%,0)
  124. call MASKINPUT(row%,col%,FieldTextAttr%,mask$,DefaultVal$,ReturnVal$,-1,Exitkey%)  'CALL MASKINPUT ROUTINE
  125. lnth% = LEN(ReturnVal$)
  126. call xqprint("The length of the value phone is "+STR$(lnth%),8,25,NormTextAttr%,0)
  127. call xqprint("The returned value for phone is "+ReturnVal$,9,25,NormTextAttr%,0)
  128. LOCATE 15,1,0 : COLOR FGColor%,BGColor%,BGColor%
  129. m1$ = "Notice how the returned value of phone is only the raw"
  130. m2$ = "data that you typed in and not any part of the mask$"
  131. m3$ = "value that you passed to the routine."
  132. call xqprint(m1$,11,25,NormTextAttr%,0) : call xqprint(m2$,12,25,NormTextAttr%,0)
  133. call xqprint(m3$,13,25,NormTextAttr%,0)
  134. call xqprint("Try Ctrl "+chr$(27)+" and Ctrl "+chr$(26)+" for next and previous word",16,1,NormTextAttr%,0)
  135. call xqprint("Try BACKSPACE with INSERT ON and INSERT OFF.  ALT-B will blank the field.",17,1,NormTextAttr%,0)
  136.  
  137. mask$ = space$(60)          'Use space$(n%) function for blank mask values
  138. DefaultVal$ = "Very good customer.  Expect large sales volume in 1988." 'default value
  139. call xqprint("COMMENT:",19,1,NormTextAttr%,0)
  140. call MASKINPUT(19,10,FieldTextAttr%,mask$,DefaultVal$,ReturnVal$,0,Exitkey%)
  141. LOCATE ,,0
  142. call delay(2)       'delay 1 second
  143. COLOR 7,0,0 : CLS:LOCATE ,,1
  144. end                 'bye bye - end of demo
  145. '********************* END OF MASKDEMO PROGRAM **************************
  146.  
  147.  
  148.